home *** CD-ROM | disk | FTP | other *** search
/ MacWorld: Complete Mac Interactive / Macworld Complete Mac Interactive CD)(1994).iso / Software / More Shareware⁄Freeware / NIH Image 1.55 f (non fpu) / Macros / More Macros < prev    next >
Text File  |  1994-04-05  |  6KB  |  251 lines
  1. macro 'Fast Invert';
  2. begin
  3.   Invert;
  4. end;
  5.  
  6. macro 'Slow Invert';
  7. {
  8. This macro illustrates why it's not a good idea to use
  9. macros for pixel-by-pixel processing.
  10. }
  11. var
  12.   width,height,value,x,y:integer;
  13. begin
  14.   RequiresVersion(1.44);
  15.   GetPicSize(width,height);
  16.   for y:=0 to height-1 do begin
  17.     GetRow(0,y,width);
  18.     for x:=0 to width-1 do LineBuffer[x]:=255-LineBuffer[x];
  19.     PutRow(0,y,width);
  20.   end;
  21. end;
  22.  
  23. macro 'Draw Vertical Calibration Bar';
  24. var
  25.   left,top,width,height,i,x,y2,inc:integer;
  26.   y:real;
  27. begin
  28.   GetRoi(left,top,width,height);
  29.   if width=0 then begin
  30.     PutMessage('Make a selection first.');
  31.     exit;
  32.   end;
  33.   SetFont('Helvetica');
  34.   SetFontSize(10);
  35.   SetText('Plain; Left; no background');
  36.   SetLineWidth(1);
  37.   Setforeground(255);
  38.   DrawScale;
  39.   x:=left;
  40.   y:=top;
  41.   inc:=height/10;
  42.   for i:=1 to 11 do begin
  43.     MoveTo(x+width+10,round(y)+2);
  44.     y2:=round(y);
  45.     if i=11 then y2:=y2-1;
  46.     write(cvalue(GetPixel(x,y2)):1:2);
  47.     y:=y+inc;
  48.   end;
  49. end;
  50.  
  51. macro 'ASCII Dump';
  52. {
  53. Generates an alphanumeric listing of pixels values starting at
  54. the upper left corner of the current selection. 20 rows and 44 columns
  55. can be displayed with the default 552 x 436 window.
  56. }
  57. var
  58.   image,dump,roiLeft,roiTop,roiWidth,roiHeight:integer;
  59.   h,v,value,MaxWidth,MaxHeight,width,height:integer;
  60. begin
  61.   image:=PicNumber;
  62.   GetRoi(RoiLeft,RoiTop,RoiWidth,RoiHeight);
  63.   if roiWidth=0 then begin
  64.     PutMessage('This macro requires a rectangular selection');
  65.     exit;
  66.   end;
  67.   SetForegroundColor(255);
  68.   SetBackgroundColor(0);
  69.   MakeNewWindow('ASCII Dump');
  70.   dump:=PicNumber;
  71.   GetPicSize(width,height);
  72.   MaxWidth:=width div 24 - 2;
  73.   MaxHeight:=height div 9 - 3;
  74.   if roiWidth>MaxWidth then roiWidth:=MaxWidth;
  75.   if roiHeight>MaxHeight then roiHeight:=MaxHeight;
  76.   SetFont('Monaco');
  77.   SetFontSize(9);
  78.   SetText('With background; Left Justified');
  79.   MoveTo(2,12);
  80.   write('    ');
  81.   for h:=roiLeft to roiLeft+roiWidth-1 do write(h:4);
  82.   writeln;
  83.   writeln;
  84.   for v:=roiTop to roiTop+roiHeight-1 do begin
  85.     write(v:3,' ');
  86.     for h:=roiLeft to roiLeft+roiWidth-1 do begin
  87.       ChoosePic(image);
  88.       value:=GetPixel(h,v);
  89.       ChoosePic(dump);
  90.       write(value:4);
  91.     end;
  92.     writeln;
  93.   end;
  94.   ChoosePic(image);
  95. end;
  96.  
  97.  
  98. macro 'Scale and Rotate All';
  99. {
  100. Resizes and/or rotates all currently open widows. For example,
  101. change the  ScaleAndRotate command below to
  102. ScaleAndRotate(2,2,0)  to change the size of all the images
  103. in a movie loop sequence from 128 x 128 to 256 x 256.
  104. }
  105. var
  106.   i:integer;
  107. begin
  108.   SaveState;
  109.   SetScaling('Bilinear; Create New Window');
  110.   for i:=1 to nPics do begin
  111.     ChoosePic(1);
  112.     ScaleAndRotate(1.9,1.9,0);
  113.     ChoosePic(1);
  114.     Close;
  115.   end;
  116.   for i:=1 to nPics do begin
  117.     ChoosePic(i);
  118.     SetPicName(i);
  119.   end;
  120.   RestoreState;
  121. end;
  122.  
  123.  
  124. macro 'Dispose All';
  125. begin
  126.   DisposeAll;
  127. end;
  128.  
  129. macro 'Average two Images';
  130.   {Generates the arithmetic average of two images.}
  131. begin
  132.   RequiresVersion(1.53);
  133.   if nPics<>2 then begin
  134.     PutMessage('This macro requires exactly two image windows to be open.');
  135.     Exit;
  136.   End;
  137.   ImageMath('add' ,1 ,2, 0.5, 0, 'Average');
  138.  end;
  139.  
  140.  
  141. macro 'Make Montage [M]';
  142. {Opens a new window and creates in it a composite image made from all}
  143. {currently open images. All the images must be the same size.}
  144. var
  145.   width,height,w,h,mWidth,mHeight,nWindows,left,top:integer;
  146.   RoiWidth,RoiHeight,RoiWidth,RoiHeight,i,hloc,vloc:integer;
  147.   montage,temp:integer;
  148.   scale:real;
  149.   SameSize:boolean;
  150. begin
  151.   nWindows:=nPics;
  152.   SameSize:=true;
  153.   GetPicSize(width,height);
  154.   for i:=1 to nPics do begin
  155.     SelectPic(i);
  156.     GetPicSize(w,h);
  157.     SameSize:=SameSize and (w=width) and (h=height);
  158.   end;
  159.   if (nWindows<2) or not SameSize then begin
  160.     PutMessage('This macro needs two or more images of the same size in order to create a montage.');
  161.     Exit;
  162.   end;
  163.   SetBackground(0);
  164.   MakeNewWindow('Montage');
  165.   montage:=nWindows+1;
  166.   GetPicSize(mWidth,mHeight);
  167.   SelectPic(1);
  168.   Duplicate('Temp');
  169.   temp:=nWindows+2;
  170.   scale:=GetNumber('Scaling Factor:',0.25);
  171.   hloc:=-(RoiWidth);
  172.   vloc:=0;
  173.   for i:=1 to nWindows do begin
  174.     SelectPic(i);
  175.     SelectAll;
  176.     copy;
  177.     SelectPic(temp);
  178.     paste;
  179.     SelectAll;
  180.     ScaleSelection(scale,scale);
  181.     RestoreRoi;
  182.     if i=1 then begin
  183.       GetRoi(left,top,RoiWidth,RoiHeight);
  184.       hloc:=-RoiWidth;
  185.       vloc:=0;
  186.     end;
  187.     Copy;
  188.     SelectPic(montage);
  189.     hloc:=hloc+RoiWidth;
  190.     if (hloc+RoiWidth)>mWidth then begin
  191.       hloc:=0;
  192.       vloc:=vloc+RoiHeight;
  193.     end;
  194.     MakeRoi(hloc,vloc,RoiWidth,RoiHeight);
  195.     Paste;
  196.   end;
  197.   KillRoi;
  198.   SelectPic(temp);
  199.   Dispose;
  200. end;
  201.  
  202.  
  203. macro 'Make Sine Wave';
  204. var
  205.   left,top,width,height,i:integer;
  206.   ppp,scale:real;
  207. begin
  208.   SaveState;
  209.   MakeNewWindow('Sine Wave');
  210.   SelectAll;
  211.   GetRoi(left,top,Width,Height);
  212.   if width=0 then begin
  213.     PutMessage('This macro requires a rectangular selection.');
  214.     Exit;
  215.   end;
  216.   ppp:=GetNumber('Pixels per period',100);
  217.   Scale:=ppp/6.28;
  218.   MakeRoi(left,top,1,height);
  219.   for i:=1 to width do begin
  220.     SetForeground(sin(i/scale)*127 +128);
  221.     {SetForeground((sin(i/scale)*127 +128)*(i+30)/(width));}
  222.     {SetForeground(sin(i/(ppp*((width-i+3)/width)/6.28))*127 +128);}
  223.     fill;
  224.     MoveRoi(1,0);
  225.   end;
  226.   KillRoi;
  227.   RestoreState;
  228. end;
  229.  
  230. macro 'Beep if No Selection [B]';
  231. var 
  232.   left,top,width,height:integer;
  233. begin
  234.   GetRoi(left,top,width,height);
  235.   if width=0 then beep;
  236. end;
  237.  
  238.  
  239. macro '(---'; begin end;
  240.  
  241. {These macros allow you to easily switch}
  242. {transfer modes while pasting by tapping keys.}
  243. macro 'Copy Mode[1]'; begin SetOption; DoCopy; end;
  244. macro 'AND Mode[2]';  begin SetOption; DoAnd; end;
  245. macro 'OR Mode [3]';  begin SetOption; DoOr; end;
  246. macro 'XOR Mode[4]'; begin SetOption; DoXor; end;
  247. macro 'REPLACE Mode[5]';  begin SetOption; DoReplace; end;
  248. macro 'BLEND [6]';  begin SetOption; DoBlend; end;
  249. macro 'Terminate Paste [7]'; begin KillRoi end;
  250.  
  251.